home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch19 / M4Ops.bas < prev    next >
BASIC Source File  |  1999-07-10  |  10KB  |  318 lines

  1. Attribute VB_Name = "M4Ops"
  2. Option Explicit
  3.  
  4. ' Four-dimensional matrix routines.
  5.  
  6. Type Point4D
  7.     coord(1 To 5) As Single
  8.     trans(1 To 5) As Single
  9. End Type
  10.  
  11. Type Segment4D
  12.     pt1 As Integer
  13.     pt2 As Integer
  14. End Type
  15.  
  16. Public Const PI = 3.14159265
  17. Public Const INFINITY = 2147483647
  18. ' Create a transformation matrix for orthographic
  19. ' projection along the X-W plane.
  20. Public Sub m4OrthoSide(M() As Single)
  21.     m4Identity M
  22.     M(1, 1) = 0
  23.     M(3, 1) = -1
  24.     M(3, 3) = 0
  25.     M(4, 4) = 0
  26. End Sub
  27. ' Create a transformation matrix for orthographic
  28. ' projection along the Y-W plane.
  29. Public Sub m4OrthoTop(M() As Single)
  30.     m4Identity M
  31.     M(2, 2) = 0
  32.     M(3, 2) = -1
  33.     M(3, 3) = 0
  34.     M(4, 4) = 0
  35. End Sub
  36.  
  37. ' Create a transformation matrix for orthographic
  38. ' projection along the W-Z plane.
  39. Public Sub m4OrthoFront(M() As Single)
  40.     m4Identity M
  41.     M(3, 3) = 0
  42.     M(4, 4) = 0
  43. End Sub
  44.  
  45. ' Create an identity matrix.
  46. Public Sub m4Identity(M() As Single)
  47. Dim i As Integer
  48. Dim j As Integer
  49.  
  50.     For i = 1 To 5
  51.         For j = 1 To 5
  52.             If i = j Then
  53.                 M(i, j) = 1
  54.             Else
  55.                 M(i, j) = 0
  56.             End If
  57.         Next j
  58.     Next i
  59. End Sub
  60.  
  61. ' Normalize a 4-D point vector.
  62. Public Sub m4NormalizeCoords(X As Single, Y As Single, Z As Single, W As Single, S As Single)
  63.     X = X / S
  64.     Y = Y / S
  65.     Z = Z / S
  66.     W = W / S
  67.     S = 1
  68. End Sub
  69.  
  70. ' Normalize a 4-D point vector.
  71. Public Sub m4NormalizePoint(P() As Single)
  72. Dim i As Integer
  73. Dim value As Single
  74.  
  75.     value = P(5)
  76.     For i = 1 To 4
  77.         P(i) = P(i) / value
  78.     Next i
  79.     P(5) = 1
  80. End Sub
  81.  
  82.  
  83. ' Normalize a 4-D transformation matrix.
  84. Public Sub m4NormalizeMatrix(M() As Single)
  85. Dim i As Integer
  86. Dim j As Integer
  87. Dim value As Single
  88.  
  89.     value = M(5, 5)
  90.     For i = 1 To 5
  91.         For j = 1 To 5
  92.             M(i, j) = M(i, j) / value
  93.         Next j
  94.     Next i
  95. End Sub
  96.  
  97.  
  98.  
  99.  
  100.  
  101. ' Create a 4-D transformation matrix for a
  102. ' perspective projection along the W axis into
  103. ' the X-Y-Z space with focus at the origin and the
  104. ' center of projection at point (0, 0, 0, D).
  105. Public Sub m4PerspectiveW(M() As Single, D As Single)
  106.     m4Identity M
  107.     If D <> 0 Then M(4, 5) = -1 / D
  108. End Sub
  109. ' Create a 4-D transformation matrix for scaling
  110. ' by scale factors Sx, Sy, Sz, and Sw.
  111. Public Sub m4Scale(M() As Single, Sx As Single, Sy As Single, Sz As Single, Sw As Single)
  112.     m4Identity M
  113.     M(1, 1) = Sx
  114.     M(2, 2) = Sy
  115.     M(3, 3) = Sz
  116.     M(4, 4) = Sw
  117. End Sub
  118.  
  119. ' Create a 3-D transformation matrix for
  120. ' translation by Tx, Ty, Tz, and Tw.
  121. Public Sub m4Translate(M() As Single, Tx As Single, Ty As Single, Tz As Single, Tw As Single)
  122.     m4Identity M
  123.     M(5, 1) = Tx
  124.     M(5, 2) = Ty
  125.     M(5, 3) = Tz
  126.     M(5, 4) = Tw
  127. End Sub
  128.  
  129. ' Create a 4-D transformation matrix for rotation
  130. ' around the XY plane (angle measured in radians).
  131. Public Sub m4XYRotate(M() As Single, theta As Single)
  132.     m4Identity M
  133.     M(3, 3) = Cos(theta)
  134.     M(4, 4) = M(3, 3)
  135.     M(3, 4) = Sin(theta)
  136.     M(4, 3) = -M(3, 4)
  137. End Sub
  138.  
  139. ' Create a 4-D transformation matrix for rotation
  140. ' around the XZ plane (angle measured in radians).
  141. Public Sub m4XZRotate(M() As Single, theta As Single)
  142.     m4Identity M
  143.     M(2, 2) = Cos(theta)
  144.     M(4, 4) = M(2, 2)
  145.     M(2, 4) = Sin(theta)
  146.     M(4, 2) = -M(2, 4)
  147. End Sub
  148.  
  149.  
  150. ' Create a 4-D transformation matrix for rotation
  151. ' around the YZ plane (angle measured in radians).
  152. Public Sub m4YZRotate(M() As Single, theta As Single)
  153.     m4Identity M
  154.     M(1, 1) = Cos(theta)
  155.     M(4, 4) = M(1, 1)
  156.     M(1, 4) = Sin(theta)
  157.     M(4, 1) = -M(1, 4)
  158. End Sub
  159. ' Create a 4-D transformation matrix for rotation
  160. ' around the XW plane (angle measured in radians).
  161. Public Sub m4XWRotate(M() As Single, theta As Single)
  162.     m4Identity M
  163.     M(2, 2) = Cos(theta)
  164.     M(3, 3) = M(2, 2)
  165.     M(2, 3) = Sin(theta)
  166.     M(3, 2) = -M(2, 3)
  167. End Sub
  168.  
  169.  
  170. ' Create a 4-D transformation matrix for rotation
  171. ' around the YW plane (angle measured in radians).
  172. Public Sub m4YWRotate(M() As Single, theta As Single)
  173.     m4Identity M
  174.     M(1, 1) = Cos(theta)
  175.     M(3, 3) = M(1, 1)
  176.     M(3, 1) = Sin(theta)
  177.     M(1, 3) = -M(3, 1)
  178. End Sub
  179.  
  180. ' Create a 4-D transformation matrix for rotation
  181. ' around the ZW plane (angle measured in radians).
  182. Public Sub m4ZWRotate(M() As Single, theta As Single)
  183.     m4Identity M
  184.     M(1, 1) = Cos(theta)
  185.     M(2, 2) = M(1, 1)
  186.     M(1, 2) = Sin(theta)
  187.     M(2, 1) = -M(1, 2)
  188. End Sub
  189.  
  190.  
  191. ' Set copy = orig.
  192. Public Sub m4MatCopy(copy() As Single, orig() As Single)
  193. Dim i As Integer
  194. Dim j As Integer
  195.  
  196.     For i = 1 To 5
  197.         For j = 1 To 5
  198.             copy(i, j) = orig(i, j)
  199.         Next j
  200.     Next i
  201. End Sub
  202.  
  203. ' Apply a transformation matrix to a point where
  204. ' the transformation may not have 0, 0, 0, 1 in
  205. ' its final column. Normalize only the X and Y
  206. ' components of the result to preserve the Z
  207. ' information.
  208. Public Sub m4ApplyFull(V() As Single, M() As Single, Result() As Single)
  209. Dim i As Integer
  210. Dim j As Integer
  211. Dim value As Single
  212.  
  213.     For i = 1 To 5
  214.         value = 0#
  215.         For j = 1 To 5
  216.             value = value + V(j) * M(j, i)
  217.         Next j
  218.         Result(i) = value
  219.     Next i
  220.     
  221.     ' Renormalize the point.
  222.     ' Note that value still holds Result(5).
  223.     If value <> 0 Then
  224.         Result(1) = Result(1) / value
  225.         Result(2) = Result(2) / value
  226.         Result(3) = Result(3) / value
  227.         ' Do not transform the w component.
  228.     Else
  229.         ' Make the W value greater than that of
  230.         ' the center of projection so the point
  231.         ' will be clipped.
  232.         Result(4) = INFINITY
  233.     End If
  234.     Result(5) = 1#
  235. End Sub
  236.  
  237.  
  238.  
  239.  
  240. ' Apply a transformation matrix to a point.
  241. Public Sub m4Apply(V() As Single, M() As Single, Result() As Single)
  242.     Result(1) = V(1) * M(1, 1) + _
  243.                 V(2) * M(2, 1) + _
  244.                 V(3) * M(3, 1) + _
  245.                 V(4) * M(4, 1) + M(5, 1)
  246.     Result(2) = V(1) * M(1, 2) + _
  247.                 V(2) * M(2, 2) + _
  248.                 V(3) * M(3, 2) + _
  249.                 V(4) * M(4, 2) + M(5, 2)
  250.     Result(3) = V(1) * M(1, 3) + _
  251.                 V(2) * M(2, 3) + _
  252.                 V(3) * M(3, 3) + _
  253.                 V(4) * M(4, 3) + M(5, 3)
  254.     Result(4) = V(1) * M(1, 4) + _
  255.                 V(2) * M(2, 4) + _
  256.                 V(3) * M(3, 4) + _
  257.                 V(4) * M(4, 4) + M(5, 4)
  258.     Result(5) = 1#
  259. End Sub
  260.  
  261. ' Multiply two matrices together. The matrices
  262. ' may not contain 0, 0, 0, 0, 1 in their last
  263. ' columns.
  264. Public Sub m4MatMultiplyFull(Result() As Single, A() As Single, B() As Single)
  265. Dim i As Integer
  266. Dim j As Integer
  267. Dim k As Integer
  268. Dim value As Single
  269.  
  270.     For i = 1 To 5
  271.         For j = 1 To 5
  272.             value = 0#
  273.             For k = 1 To 5
  274.                 value = value + A(i, k) * B(k, j)
  275.             Next k
  276.             Result(i, j) = value
  277.         Next j
  278.     Next i
  279. End Sub
  280. ' Multiply two matrices together.
  281. Public Sub m4MatMultiply(Result() As Single, A() As Single, B() As Single)
  282.     Result(1, 1) = A(1, 1) * B(1, 1) + A(1, 2) * B(2, 1) + A(1, 3) * B(3, 1) + A(1, 4) * B(4, 1)
  283.     Result(1, 2) = A(1, 1) * B(1, 2) + A(1, 2) * B(2, 2) + A(1, 3) * B(3, 2) + A(1, 4) * B(4, 2)
  284.     Result(1, 3) = A(1, 1) * B(1, 3) + A(1, 2) * B(2, 3) + A(1, 3) * B(3, 3) + A(1, 4) * B(4, 3)
  285.     Result(1, 4) = A(1, 1) * B(1, 4) + A(1, 2) * B(2, 4) + A(1, 3) * B(3, 4) + A(1, 4) * B(4, 4)
  286.     Result(1, 5) = 0#
  287.     Result(2, 1) = A(2, 1) * B(1, 1) + A(2, 2) * B(2, 1) + A(2, 3) * B(3, 1) + A(2, 4) * B(4, 1)
  288.     Result(2, 2) = A(2, 1) * B(1, 2) + A(2, 2) * B(2, 2) + A(2, 3) * B(3, 2) + A(2, 4) * B(4, 2)
  289.     Result(2, 3) = A(2, 1) * B(1, 3) + A(2, 2) * B(2, 3) + A(2, 3) * B(3, 3) + A(2, 4) * B(4, 3)
  290.     Result(2, 4) = A(2, 1) * B(1, 4) + A(2, 2) * B(2, 4) + A(2, 3) * B(3, 4) + A(2, 4) * B(4, 4)
  291.     Result(2, 5) = 0#
  292.     Result(3, 1) = A(3, 1) * B(1, 1) + A(3, 2) * B(2, 1) + A(3, 3) * B(3, 1) + A(3, 4) * B(4, 1)
  293.     Result(3, 2) = A(3, 1) * B(1, 2) + A(3, 2) * B(2, 2) + A(3, 3) * B(3, 2) + A(3, 4) * B(4, 2)
  294.     Result(3, 3) = A(3, 1) * B(1, 3) + A(3, 2) * B(2, 3) + A(3, 3) * B(3, 3) + A(3, 4) * B(4, 3)
  295.     Result(3, 4) = A(3, 1) * B(1, 4) + A(3, 2) * B(2, 4) + A(3, 3) * B(3, 4) + A(3, 4) * B(4, 4)
  296.     Result(3, 5) = 0#
  297.     Result(4, 1) = A(4, 1) * B(1, 1) + A(4, 2) * B(2, 1) + A(4, 3) * B(3, 1) + A(4, 4) * B(4, 1)
  298.     Result(4, 2) = A(4, 1) * B(1, 2) + A(4, 2) * B(2, 2) + A(4, 3) * B(3, 2) + A(4, 4) * B(4, 2)
  299.     Result(4, 3) = A(4, 1) * B(1, 3) + A(4, 2) * B(2, 3) + A(4, 3) * B(3, 3) + A(4, 4) * B(4, 3)
  300.     Result(4, 4) = A(4, 1) * B(1, 4) + A(4, 2) * B(2, 4) + A(4, 3) * B(3, 4) + A(4, 4) * B(4, 4)
  301.     Result(4, 5) = 0#
  302.     Result(5, 1) = A(5, 1) * B(1, 1) + A(5, 2) * B(2, 1) + A(5, 3) * B(3, 1) + A(5, 4) * B(4, 1) + B(5, 1)
  303.     Result(5, 2) = A(5, 1) * B(1, 2) + A(5, 2) * B(2, 2) + A(5, 3) * B(3, 2) + A(5, 4) * B(4, 2) + B(5, 2)
  304.     Result(5, 3) = A(5, 1) * B(1, 3) + A(5, 2) * B(2, 3) + A(5, 3) * B(3, 3) + A(5, 4) * B(4, 3) + B(5, 3)
  305.     Result(5, 4) = A(5, 1) * B(1, 4) + A(5, 2) * B(2, 4) + A(5, 3) * B(3, 4) + A(5, 4) * B(4, 4) + B(5, 4)
  306.     Result(5, 5) = 1#
  307. End Sub
  308.  
  309.  
  310. ' Give the vector the indicated length.
  311. Public Sub m4SizeVector(ByVal L As Single, X As Single, Y As Single, Z As Single, W As Single)
  312.     L = L / Sqr(X * X + Y * Y + Z * Z + W * W)
  313.     X = X * L
  314.     Y = Y * L
  315.     Z = Z * L
  316.     W = W * L
  317. End Sub
  318.